C/C++ Interactive Reference Guide/C-C++ Interactive Reference Guide.iso/c_ref/csource5/357_01/cstar1.exe/DCL.C

C/C++ Source or Header | 1991-06-18 | 58.3 KB | 2,313 lines

/*
    C* -- Parser Part II (declarations)

    Source:  dcl.c
    Started: October 21, 1985
    Version:
        March 4, 1987;
        February 25, 1989: New Sherlock macros added.

    PUBLIC DOMAIN SOFTWARE

    The CSTAR program was placed in    the public domain on June 15, 1991,
    by its author and sole owner,

        Edward K. Ream
        1617 Monroe Street
        Madison, WI 53711
        [phone]

    CSTAR may be used for any commercial or non-commercial purpose.

    See cstar.h or cstar.c for a DISCLAIMER OF WARRANTIES.
*/
#include "cstar.h"

/*
    WARNING: according to the C Journal, Winter 1987, p.58, const and
    volatile don't stick to structure tags.  Our copy of the draft
    standard is silent on this arcane point.  Use #define SC_STICKY 0
    to implement them that way, and use 1 to implement them as pure
    type adjectives which behave cumulatively.

    WARNING: pd_taeq and pd_teq: it is not clear whether structures
    having the same tag (and which are therefore identical in all respects
    except outer const and volatile) but differing as to outer
    const or volatile should be regarded as being of the same type or as
    of different types.  At present, as with const and nonconst int,
    they are regarded as if they are the same type, for most purposes.
*/
extern int reg_size[];

/*
    Externally visible routines:
*/
void    pd_tcopy    (struct type_node *s,  struct type_node *d);
bool    pd_teq        (struct type_node *t1, struct type_node *t2);
bool    pd_t1eq        (struct type_node *t1, struct type_node *t2);
bool    pd_taeq        (struct type_node *t1, struct type_node *t2);
void    reg_check    (struct type_node *type, int regtype, char *symbol);
unsigned long    m_size    (int m);
bool    pd_is1func    (struct type_node *t);
void    pd_orphan    (struct type_node *t);
struct type_node *
    pd_cast        (void);
struct type_node *
    pd_stmt    (int kind, int plural, struct type_node **head_x);


/*
    Internal routines:
*/
static struct type_node *
    pd_head    (int kind, int * sclass);
static struct type_node *
    pd_tail    (int kind, struct type_node *head_type,
            char ** dsymbol, int * regtype, int headclass);
static struct type_node *
    pd_t1        (int kind, struct type_node * head_type,
            char ** dsymbol, int * regtype, int headclass);
static int
    pd_post    (register struct type_node *t);
static struct type_node *
    pd_p1        (register struct type_node *t, register int mods);
static struct st_node *
    pd_var    (int sclass, struct type_node *type, char * symbol);
static char *    pd_name    (void);
static void    pd_iniz    (struct st_node *id);
static struct iblock *
    pd_par        (register struct type_node *t, unsigned long size);


/*
    NOTE about const and volatile

    Handling of CONST_MOD and VOLATILE_MOD is peculiar.  See this
    entire note.

    const and volatile are peculiar entities, not really storage classes,
    and not really types.  Like static, volatile will typically be
    a statement about the properties of a location.  However,
    syntactically and logically to a certain extent, it is treated
    as a type.  One does not distinguish pointer to static int from
    pointer to some other int, but one does distinguish pointer
    to volatile int from pointer to int from volatile pointer to int.
    (Actually, one might want to distinguish pointer to auto int
    from pointer to static int, and disallow returning the former it
    from a function, but let that slide.)

    In addition, const and volatile have implications for expression
    checking and code generation and act in that context rather like
    types, in they disallow certain operations in rather the
    same manner that inappropriate types would disallow them.  With
    the sole exception of address-of a register, storage classes
    don't do that.

    Furthermore, const and volatile (?) propagate within aggregates,
    so that if an array is const, so are its elements.  This is also
    implicitly true of all other storage classes, but it has no
    consequences to speak of, because those storage classes attach
    to the declared object rather than to its type specification.

    Because of the other-worldly syntax of declarations, which
    can't be blamed on the standards committee, a number of
    bizarre facts need to be noted:

        1. a declaration like
           const int ** const * x;
           is possible, as is the corresponding cast.  Blame the
           original syntax for suggesting this form, and the
           committee for accepting the suggestion.

        2. in the declaration
           const static unsigned int *x;
           register describes the location where the pointer-to-integer
           x is stored, but const (implicitly) describes the location
           which x points to (i.e., it is to be treated like ROM),
           while unsigned describes how said location (be it static,
           ROM, or both) is to be regarded when used as an arithmetic
           entity.  That is, one must remember which of the twenty-odd
           possible descriptors gets attached to the pointer, and
           which to the item pointed to, in such declarations.

        3. in full C, the useless declaration
           const register x;
           is syntactically possible.  Its uselessness stems from
           the lack of any means to specify, either in the C code,
           or through the linker, which particular register is
           intended.

        4. in the declaration
           const a[5];
           the const attribute attaches both to a, regarded as
           "the array" and to *(a+3), the latter being an array
           element, since the attribute propagates to the elements
           of an aggregate.
           In
           const *a;
           the const attribute attaches to *(a+3), but not to
           "the pointer" a.
           Finally, in the formal
           const a[];
           your guess is as good as ours.  Ours is to treat it
           exactly as if
           const *a;
           had been written.

    Within the C-Star compiler, there are a number of complex
    implications.

        1. Normal storage classes get attached directly to
           the symbol table entry, since they have nothing
           to do with its type, although some classes are not
           allowed for some types.

        2. Normal type specifiers are divided into two classes,
           roughly types and modifiers.  The mutually exclusive
           set int, pointer, array, struct, union, float are
           treated as type, and entered as the primary node type.
           The rest, including char, are treated as modifiers,
           some of which may disallow others.

        3. const and volatile are treated as special modifiers
           (SC_MODS).    Their storage-class-like properties
           require them to propagate, however, and the kludge
           which handles this is located partly in pd_stmt
           and partly in pd_alloc.

    const and volatile are handled in pd_stmt, pd_head, pd_tail,
    and pd_alloc, and in some non-obvious ways that must not be
    tampered with lightly.  (other analogous modifying declarators
    are handled fully by pd_head.)  pd_head parses them in the
    obvious way.  pd_tail parses them after the pointer-to
    asterisk, and attaches them to the proper pointer-to nodes,
    according to an extension of the usual inside-out syntax.
    pd_stmt propagates them from STRUCT_TYPE and UNION_TYPE heads
    to SELEMENT and UELEMENT nodes (only).  This simplifies pd_alloc,
    which does the remaining propagation.
*/

/* ---------- VISIBLE FUNCTIONS ----------- */
/*
    Copy one existing type_node into another existing type_node.
    This is a kludge to allow for the redeclaration of formals.
*/
void
pd_tcopy(register struct type_node *s, struct type_node *d)
{
    register int i;

    TRACEPB("pd_tcopy", printf("(%p, %p)\n", s, d));

    if (s == NULL || d == NULL) {
        RETURN_VOID("pd_tcopy");
    }
    i = sizeof(struct type_node)/sizeof(int);
    while (i--) {
        *((int *)d)++ = *((int *)s)++;
    }

    TICKX("pd_tcopy");
}

/*
    Check for fairly rigorous type equality.
    SC_MODS (e.g. CONST_MOD) are not checked here; the appropriate
    branch of setype checks those (e.g. assignments check CONST_MOD).
*/
bool
pd_teq(struct type_node *t1, struct type_node *t2)
{
    bool result;

    TRACEPB("pd_teq",
        printf("(%p, %p)\n", t1, t2);
        pr_type(t1); pr_type(t2));

    while (t1 && t2) {
        if (t1 == t2) {
            RETURN_BOOL("pd_teq", TRUE);
        }
        if ( t1 -> t_typtok != t2 -> t_typtok) {
            RETURN_BOOL("pd_teq", FALSE);
        }

        switch (t1 -> t_typtok) {
        case STRUCT_TYPE:
        case UNION_TYPE:
            /* structs same if t1 == t2 or if same tag */
            if(t1 -> t_parent && t1 -> t_parent == t2 -> t_parent){
                RETURN_BOOL("pd_teq", TRUE);
            }
            else {
                RETURN_BOOL("pd_teq", FALSE);
            }

        case POINTER_TYPE:
            /* pointer to void matches pointer to anything else */
            t1 = t1 -> t_link;
            t2 = t2 -> t_link;
            if (t1 && t2 && (t1 -> t_typtok == VOID_TYPE ||
                        t2 -> t_typtok == VOID_TYPE)) {
                RETURN_BOOL("pd_teq", TRUE);
            }
            break;

        case ARRAY_TYPE:
            if (t1 -> t_tdim != t2 -> t_tdim ||
                    t1 -> t_tsize  != t2 -> t_tsize) {
                RETURN_BOOL("pd_teq", FALSE);
            }
            goto linkit;

        case INT_TYPE:
            if ( (t1->t_mclass & ~SC_MODS) !=
                     (t2->t_mclass & ~SC_MODS) ) {
                RETURN_BOOL("pd_teq", FALSE);
            }
            /* FALLTHROUGH */

        linkit:
        default:
            t1 = t1 -> t_link;
            t2 = t2 -> t_link;
        }
    }
    RETURN_BOOL("pd_teq", t1 == t2);
}

/*
    Check for slightly less rigorous type equality; array top-level
    need not match.
*/
bool
pd_t1eq(register struct type_node *t1, register struct type_node *t2)
{
    TRACEPB("pd_t1eq",
        printf("(%p, %p)\n", t1, t2);
        pr_type(t1); pr_type(t2));

    if (t1 && t1 -> t_typtok == ARRAY_TYPE &&
        t2 && t2 -> t_typtok == ARRAY_TYPE) {
        RETURN_BOOL("pd_t1eq", pd_teq(t1 -> t_link, t2 -> t_link));
    }
    else {
        RETURN_BOOL("pd_t1eq", pd_teq(t1, t2));
    }
}

/*
    As pd_teq, except that POINTER_TYPE matches any ARRAY_TYPE at each
    [linear-] tree level.

    Arrays of different dimensionality still cause a mismatch.
    This is based on the notion that if someone writes array of 10
    and pointer to same, that is what one wants; pointer to pointer
    or maybe pointer to void would more usually be written.
*/
bool
pd_taeq(register struct type_node *t1, register struct type_node *t2)
{
    TRACEPB("pd_taeq",
        printf("(%p, %p)\n", t1, t2);
        pr_type(t1); pr_type(t2));

    while (t1 && t2) {
        TRACE("pd_taeq", printf("pd_taeq loop: %p, %p\n", t1, t2));
        if (t1 == t2) {
            RETURN_BOOL("pd_taeq", TRUE);
        }
        if (t1 -> t_typtok != t2 -> t_typtok) {
            if ( (t1 -> t_typtok == POINTER_TYPE &&
                  t2 -> t_typtok == ARRAY_TYPE) ||
                 (t2 -> t_typtok == POINTER_TYPE &&
                  t1 -> t_typtok == ARRAY_TYPE) ) {
                /* allow mixed case */
                t1 = t1 -> t_link;
                t2 = t2 -> t_link;
                TRACEP("pd_taeq", printf("mixed p/a\n"));
                continue;
            }
            else {
                TRACEP("pd_taeq", printf("typtok mismatch\n"));
                RETURN_BOOL("pd_taeq", FALSE);
            }
        }

        /* in the mixed pointer/array case, it never gets here */
        switch (t1 -> t_typtok) {
        case STRUCT_TYPE:
        case UNION_TYPE:
            /* structs same if t1 == t2 or if same tag */
            if(t1 -> t_parent && t1 -> t_parent == t2 -> t_parent){
                RETURN_BOOL("pd_taeq", TRUE);
            }
            else {
                RETURN_BOOL("pd_taeq", FALSE);
            }

        case POINTER_TYPE:
            /* pointer to void matches pointer to anything else */
            t1 = t1 -> t_link;
            t2 = t2 -> t_link;
            if (t1 && t2 && (t1 -> t_typtok == VOID_TYPE ||
                        t2 -> t_typtok == VOID_TYPE)) {
                RETURN_BOOL("pd_taeq", TRUE);
            }
            break;

        case ARRAY_TYPE:
            if (t1 -> t_tdim != t2 -> t_tdim ||
                    t1 -> t_tsize  != t2 -> t_tsize) {
                RETURN_BOOL("pd_taeq", FALSE);
            }
            goto tanext;

        case INT_TYPE:
            if ( (t1->t_mclass & ~SC_MODS) !=
                     (t2->t_mclass & ~SC_MODS) ) {
                TRACE("pd_taeq", printf("pd_taeq mclass FALSE: %d, %d\n",
                    t1 -> t_mclass & ~SC_MODS,
                        t2 -> t_mclass & ~SC_MODS));
                RETURN_BOOL("pd_taeq", FALSE);
            }
            /* FALLTHROUGH */

        tanext:
        default:
            t1 = t1 -> t_link;
            t2 = t2 -> t_link;
        }
    }
    RETURN_BOOL("pd_taeq", (t1 == t2));
}

/*
    Check the type of a register, for aggregates, wrong length, etc.
    Do t_error() if it is bad; but do not attempt any patch or fix.
    Reg_type must not be zero.
*/
void
reg_check(struct type_node *type, int regtype, char *symbol)
{
    TRACEPB("reg_check", printf("(%p, %d, %s)\n", type, regtype, symbol));

    switch(type -> t_typtok) {
    case INT_TYPE:
    case POINTER_TYPE:
        if ((unsigned long)(unsigned)
            reg_size[regtype] != type -> t_tsize) {
            t_2error("type is of inappropriate length for: ",
                symbol);
        }
        break;
    default:
        t_2error("register not pointer or integer: ",symbol);
        break;
    }

    TICKX("reg_check");
}

/*
    Return the size of an mclass
*/
unsigned long
m_size(int m)
{
    TICK("m_size");

    if (m & LONG_MOD) {
        return (long)LONG_SIZE;
    }
    else if (m & CHAR_MOD) {
        return (long)CHAR_SIZE;
    }
    else if (m & SHORT_MOD) {
        return (long)SHORT_SIZE;
    }
    else {
        return (long)INT_SIZE;
    }
}

/*
    Test a DELEMENT type_node to see if it is a declaration of exactly one
    function.
*/
bool
pd_is1func(struct type_node *t)
{
    TRACEPB("pd_is1func", printf("(%p)\n", t));

    if (t -> t_list != NULL || t -> t_link == NULL) {
        RETURN_BOOL("pd_is1func", FALSE);
    }
    if (t -> t_link -> t_typtok != FUNCTION_TYPE) {
        RETURN_BOOL("pd_is1func", FALSE);
    }
    RETURN_BOOL("pd_is1func", TRUE);
}

/*
    Given a DELEMENT, go through the list and null out all the
    parent nodes.  This is for removing names of formals from a function
    argument list once the names go out of scope.  It is meant
    to ensure that there aren't any dangling pointers left around.
*/
void
pd_orphan(register struct type_node *t)
{
    TRACEPB("pd_orphan", printf("(%p)\n", t));

    while (t != NULL) {
        if (t -> t_typtok != DELEMENT_TYPE) {
            t_error("pd_orphan: internal: not a D_ELEMENT");
            break;
        }
        t -> t_parent = NULL;
        t = t -> t_list;
    }

    TICKX("pd_orphan");
}

/*
    Handle the innards of a cast.  Return NULL if not cast.
    The decision as to whether "not a cast" is an error
    IS TO BE MADE BY THE CALLER.

    The opening parenthesis has already been read.
    This form is also called by do_sizeof()
*/
struct type_node *
pd_cast(void)
{
    register struct type_node * t;
    register struct st_node * id;
    int class;

    TICKB("pd_cast");

    if (is_kdecl(t_type) ||
        ( t_type == ID_TOK && (id = ast_lookup(t_symbol)) != NULL &&
            id -> st_sclass == TYPEDEF_CLASS) ) {
        /* note that pd_head ALWAYS returns something */
        t = pd_head(CAST_TYPE, &class);
        t = pd_tail(CAST_TYPE, t, NULL, NULL, NULL_CLASS);
        RETURN_PTR("pd_cast", t);
    }
    RETURN_PTR("pd_cast", NULL);
}


/*
    Parse a list of declarations.

    Each declaration consists of:
        exactly one pd_head
    followed by:
        repeated pd_tails separated by commas
    and terminating
        with a comma, if there is more
        with a type keyword, if formal decls follow
        with a left brace, if function defn and no decls
        with a non-comma, otherwise

    a function definition causes a fatal error if it is not
    in FILE_SCOPE.

    kind:    NULL_TYPE:    build no list
        UELEMENT_TYPE:    build a union element list
        SELEMENT_TYPE:    build a structure element list
        DELEMENT_TYPE:    build a declaration list

    plural:
        TRUE:    parse a series of decls into one list, taking up
                the last semicolon. it is assumed that
                the routine is called on a proper decl head.
                the storage class defaults to something
                suitable to the scope.

        FALSE:    parse only as long as more commas are encountered, and
                leave the non-comma token. a proper decl head
                is not required; the first item may be an
                identifier, which will be defaulted to an
                int of storage class suitable to the scope

    head_x:

        NULL:    nothing happens

        ADDRESS:    address of head-type node is returned here.
                this is senseless if plural is enabled.

    return:    kind == NULL_TYPE:
                NULL
        kind != NULL_TYPE:
                a list of typenodes of type kind, threaded
                via t_list, with each of these nodes
                attached to a typenode string threaded via
                t_link.  see above for the sensible values
                of kind.  NOTE: you only get the chain of
                element nodes, not the enclosing STRUCT,
                UNION, or DECL.  see list above.

    IN THE EVENT OF A DUPLICATE DECLARATION, SOMETHING REFLECTING THE
    OLD TYPE, NOT THE CURRENT PARSE, IS HOOKED INTO THE LIST!!!

    This keeps symbol table nodes and parent nodes linked properly,
    but it may lead to amusing structure definitions.

    It also makes it easier to handle the redeclaration of formals,
    which is really why it was done.

    In this event, t_error is raised, so no code should be generated
    anyhow.
*/
struct type_node *
pd_stmt(int kind, int plural, struct type_node **head_x)
{
    register struct type_node *d_type, *type, *head_type;
    int head_class;
    struct st_node *id;
    struct type_node root_node;
    register struct type_node *ltail, *lp;

    char *symbol;
    int regtype;

    /*
        First parse the head.
        See notes on pd_head to know what a head is!
    */

    TRACEPB("pd_stmt", printf("(%d, %d, %p)\n", kind, plural, head_x));

    root_node.t_list = NULL;
    ltail = &root_node;

    for (;;) {
        head_type = pd_head(kind, &head_class);

        /* parse a list of tails, until a non-comma */
        for(;;) {
            symbol = NULL;
            id = NULL;
            d_type = type =
                pd_tail(kind, head_type,
                    &symbol, ®type, head_class);

            if (kind) {
                lp = new_tnode();
                lp -> t_typtok = kind;
                lp -> t_link = type;

                ltail -> t_list = lp;
                ltail = lp;

                switch(kind) {
                case UELEMENT_TYPE:
                    d_type = lp;
                    if ((type -> t_typtok == STRUCT_TYPE ||
                        type -> t_typtok == UNION_TYPE) &&
                        type -> t_list == NULL) {
                        t_error("undefined struct/union");
                    }
                    break;

                case SELEMENT_TYPE:
                    d_type = lp;    /* so that variable, as
                            entered in symbol table,
                            shows up as element type */
                    if ((type -> t_typtok == STRUCT_TYPE ||
                        type -> t_typtok == UNION_TYPE) &&
                        type -> t_list == NULL) {
                        t_error("undefined struct/union");
                    }
                    break;

                case DELEMENT_TYPE:
                    break;

                default:
                    t_error("pd_stmt: shouldn't happen");
                }
            }
            /* end of the element */

            /*
                note: certain declarations of formals are
                disallowed by pd_var and need not concern
                us here.
            */
            if (symbol != NULL) {
                /* then something is declared */
                if (regtype) {
                    reg_check(d_type, regtype, symbol);
                    switch(head_class) {
                    case REGISTER_CLASS:
                    case AUTO_CLASS:
                        id = pd_var(REGISTER_CLASS,
                             d_type, symbol);
                        id -> st_misc |= regtype;
#ifdef SCRATCH
                        if (regtype && reg_idx(regtype) <= SCRATCH) {
#else
                        if (regtype && reg_idx(regtype) == 0) {
#endif
                            t_2warning("register may be clobbered by function calls: ", arp_tab[regtype]);
                            t_warning("that includes implicit function calls such as lmul");
                        }
                        break;
                    default:
                        id = pd_var(head_class, d_type, symbol);
                        t_error("inappropriate use of register name keyword");
                    }
                }
                else {
                    id = pd_var(head_class, d_type, symbol);
                }
                d_type = type = id -> st_type;
                if (kind) {
                    TRACEP("pd_stmt",
                      printf("assign parent %p\n", id));
                    lp -> t_parent = id;
                }
            }
            else if (head_type -> t_typtok != STRUCT_TYPE &&
                 head_type -> t_typtok != UNION_TYPE) {
                t_warning("empty declaration");
            }

            /* check for initializer */
            if (kind == DELEMENT_TYPE && t_type == ASSN_TOK) {
                get_token();
                pd_iniz(id);
            }

            /* Is there another element? */
            if (t_type == COMMA_TOK) {
                get_token();
            }
            else {
                break;
            }

        } /* end tails loop */

        /* check for end of declaration */
        if (!plural) {
            break; /* out of statement-list loop */
        }
        if (t_type == SEMICOLON_TOK) {
            get_token();
        }
        else {
            need(SEMICOLON_TOK);
            if (is_kdecl(t_type) || t_type == LCURLY_TOK) {
                if (type != NULL &&
                     type -> t_typtok == FUNCTION_TYPE) {
                    t_warning("check brace structure");
                    fatal("function definition in code");
                }
            }
        }
        /* now continue along if it's another type keyword */
        if (is_kdecl(t_type)) {
            continue;
        }
        else if (t_type == ID_TOK) {
            id = ast_lookup(t_symbol);
            if (id == NULL) {
                break;
            }
            else if (id -> st_sclass == TYPEDEF_CLASS) {
                continue;
            }
            else {
                break;
            }
        }
        else {
            break;
        }
    }

    /* Drop root node. */
    TRACEP("pd_stmt",
        printf("return type %p:\n",root_node.t_list);
        pr_type(root_node.t_list); printf("\n");
    );

    if (head_x) {
#ifdef DEBUG
        if (plural) {
            t_error("pd_stmt: internal: senseless use of head_x");
        }
#endif /* DEBUG */
        *head_x = head_type;
    }
    RETURN_PTR("pd_stmt", (root_node.t_list));
}

/*
    Parse the head of a declaration/function definition.
    Also see the notes under decl.
    Produce a type tree, and a storage-class word.

    A head contains:
        An optional sc-specifier
    and then
        Optional modifiers from the K&R list
    and then
        An optional noun, which may be
            A typedef tag
        or else
            A noun from the K&R list (e.g. int)
        or else struct or union followed by:
            either a structure tag
            or a struct/union definition (in braces)
            or both


    A head does not contain:
        Parentheses
        Asterisks
        Brackets
        Identifiers except for typedef tags
    or anything else, so it is deemed to end when such is found

    The node tree returned is supposed to always have a base
    type at the end of the typelink-string, that is, a noun keyword or
    a structure tag.

    The sequence:
        typedef unsigned tag;
        tag char xyz;
    shall lead to an error, the gist of which is that xyz cannot
    be both a char and an int.  The distinction made herein
    between modifiers and nouns is muddled in the standard;
    although it seems not, it could be that it "really" is that
    allowed and disallowed keyword combinations are    described
    by an arbitrary matrix.

    Every typelink-string must eventually end with a node
        whose t_typtok is one of:
            INT_TYPE
            STRUCT_TYPE
            UNION_TYPE
            VOID_TYPE

        and, in particular, is not one of:
            ARRAY_TYPE
            FUNCTION_TYPE
            POINTER_TYPE
            SELEMENT_TYPE
            UELEMENT_TYPE

    The STRUCT_TYPE and UNION_TYPE nodes have a second pointer
        which is the list of element nodes.

    kind:      CAST_TYPE:        declaration is inside a cast
         SELEMENT_TYPE:    declaration is inside a struct
         UELEMENT_TYPE:    declaration is inside a union

    sclass:            address-of the storage class, which
                is no longer part of the type node

    return:            a type_node which reflects the contents
                of the "header"
                SOMETHING IS ALWAYS RETURNED; RESULT IS NEVER
                EVER NULL.  the default is a 2-byte int.
*/
static struct type_node *
pd_head(int kind, int * sclass)
{
    register struct st_node *id, *id1;
    register struct type_node *t, *t1;
    register int sc_count, m;
    int s_f, u_f;
    long ssize;
    char *symbol;

    /* Set up as a default to auto int. */

    TRACEPB("pd_head", printf("(%d, %p)\n", kind, sclass));

    t = new_tnode();
    TRACEP("pd_head", printf("new_tnode %p\n", t));

    switch(scope.s_scope) {
    case PROTO_SCOPE:
    case FNDEF_SCOPE:
        *sclass = FORMAL_CLASS;
        break;

    case BLOCK_SCOPE:
        *sclass = AUTO_CLASS;
        break;

    case FILE_SCOPE:
        *sclass = GLOBAL_CLASS;
        break;
    default:
        fatal("pd_head: internal: unknown scope");
    }

    /* Storage-class specifiers. */
    sc_count = 0;
    for(;;) {
        switch(t_type) {

        case K_TYPEDEF:
            switch(scope.s_scope) {
            case PROTO_SCOPE:
            case FNDEF_SCOPE:
                t_error("typedef keyword in formal");
                break;
            default:
                *sclass = TYPEDEF_CLASS;
            }
            sc_count++;
            get_token();
            continue;

        case K_EXTERN:
            switch(scope.s_scope) {
            case PROTO_SCOPE:
            case FNDEF_SCOPE:
                t_error("extern declaration of formal");
                break;
            default:
                *sclass = EXTERN_CLASS;
            }
            sc_count++;
            get_token();
            continue;

        case K_AUTO:
            if (scope.s_scope == BLOCK_SCOPE) {
                *sclass = AUTO_CLASS;
            }
            else {
                t_error("auto declaration--not a local variable");
            }
            sc_count++;
            get_token();
            continue;

        case K_REGISTER:
            TRACEP("pd_head", printf("K_REGISTER, scope %d\n",
                            scope.s_scope));
            switch(scope.s_scope) {
            case PROTO_SCOPE:
            case FNDEF_SCOPE:
                *sclass = FORMREG_CLASS;
                break;
            case BLOCK_SCOPE:
                *sclass = REGISTER_CLASS;
                break;
            default:
                t_error("global declared as register type");
            }
            sc_count++;
            get_token();
            continue;

        case K_STATIC:
            switch(scope.s_scope) {
            case PROTO_SCOPE:
            case FNDEF_SCOPE:
                t_error("static declaration of formal");
                break;
            case BLOCK_SCOPE:
                *sclass = STATICL_CLASS;
                break;
            default:
                *sclass = STATICG_CLASS;
                break;
            }
            sc_count++;
            get_token();
            continue;
        }
        break;
    }
    if (sc_count > 1) {
        t_error("more than one sc-specifier in declaration");
    }

    if (sc_count) {
        switch (kind) {
        case CAST_TYPE:
            t_error("sc-specifier within cast");

            break;
        case UELEMENT_TYPE:
        case SELEMENT_TYPE:
            t_error("sc-specifier inside structure or union");
        }
    }

    /* Modifiers of the base type. */
    s_f = u_f = 0;
    for(;;) {
        TRACEP("pd_head", printf("modifier\n"));
        switch(t_type) {

        case K_CONST:
            t -> t_mclass |= CONST_MOD;
            get_token();
            continue;

        case K_VOLATILE:
            t -> t_mclass |= VOLATILE_MOD;
            get_token();
            continue;

        case K_UNSIGNED:
            u_f = 1;
            if (s_f) {
                t_error("signed unsigned??");
            }
            get_token();
            continue;

        case K_SIGNED:
            s_f = 1;
            if (u_f) {
                t_error("unsigned signed??");
            }
            get_token();
            continue;

        case K_CHAR:
            if (t -> t_mclass & (LONG_MOD | SHORT_MOD)) {
                t_error("long/short char??");
            }
            else {
                t -> t_mclass |= CHAR_MOD;
                t -> t_tsize = CHAR_SIZE;
            }
            get_token();
            continue;

        case K_SHORT:
            if (t -> t_mclass & (LONG_MOD | CHAR_MOD)) {
                t_error("long/char short??");
            }
            else {
                t -> t_mclass |= SHORT_MOD;
                t -> t_tsize = SHORT_SIZE;
            }
            get_token();
            continue;

        case K_LONG:
            if (t -> t_mclass & (SHORT_MOD | CHAR_MOD)) {
                t_error("char/short long??");
            }
            else {
                t -> t_mclass |= LONG_MOD;
                t -> t_tsize = LONG_SIZE;
            }
            get_token();
            continue;

        }
        break;
    }
    if (s_f) {
        t -> t_mclass &= ~UNSIGNED_MOD;
    }
    else if (u_f) {
        t -> t_mclass |= UNSIGNED_MOD;
    }

    /* Pick up the base type. */
    TRACEP("pd_head", printf("base type\n"));
    switch(t_type) {
    case K_INT:
        get_token();
        break;

    case K_VOID:
        t -> t_typtok = VOID_TYPE;
        t -> t_tsize = 0;
        if (t -> t_mclass & ARITH_MODS) {
            t_error("long, short, etc. do not apply to void");
            t -> t_mclass &= ~ARITH_MODS;
        }
        get_token();
        break;

    case K_UNION:
    case K_STRUCT:
        if (t_type == K_STRUCT) {
            kind = SELEMENT_TYPE;
            t -> t_typtok = STRUCT_TYPE;
        }
        else {
            kind = UELEMENT_TYPE;
            t -> t_typtok = UNION_TYPE;
        }
        t -> t_tsize = 0;

        if (t -> t_mclass & ARITH_MODS) {
            t_error("long, short, etc. do not apply to struct/union");
            t -> t_mclass &= ~ARITH_MODS;
        }
        get_token();

        /*
            Deal with tag if there is one
        */

        /*
           WARNING: this code cannot check for undefined tags.
           That must be done by some sort of post-pass, or
           else by the operators that use structure elements
           An undefined tag is one that doesn't have a t_list
           (list of elements) by the time it is used in code.
        */
        id = NULL;    /* Signify that there is no tag. */
        symbol = NULL;    /* Set up for possible later use. */
        if (t_type == ID_TOK) {
            /* Must be a tag. */
            symbol = str_salloc(t_symbol);
            id = ast_lookup(t_symbol);
            get_token();

            if (id == NULL) {
                /* a possibly vacuous entry */
                id = rst_enter(symbol, t, TAG_CLASS);
            }
            else if (id -> st_sclass != TAG_CLASS) {
                /*
                    A symbol of this name exists.  If
                    it is not in the CURRENT scope,
                    re-enter it.  If it is in the current
                    scope, then it is no good.
                */
                id = rst_lookup(symbol);
                if (id == NULL) {
                    id = rst_enter(symbol, t, TAG_CLASS);
                }
            }
            else if (t_type == LCURLY_TOK) {
                /*
                    Re-enter the symbol in the current scope
                    if and only if a definition follows
                */
                id = rst_lookup(symbol);
                if (id == NULL) {
                    t_2warning("definition hides earlier one: ", symbol);
                    id = rst_enter(symbol, t, TAG_CLASS);
                }
            }
            /* id is not null any more, ever, at this point  */
            /* however, id is not guaranteed to be valid yet */

            /* Now check the tag for certain kinds of validity. */
            if (id -> st_sclass != TAG_CLASS) {
                t_2error("not a tag: ", symbol);
                id = NULL;
            }
            else if (id -> st_type == NULL) {
                t_2error("internal: untyped tag: ", symbol);
                id -> st_type = t;
            }
            else if (id -> st_type -> t_typtok != t -> t_typtok) {
                t_2error("conflicting struct/union use of tag: ", symbol);
                TRACEP("pd_head1",
                  pr_type(id -> st_type); printf("\n");
                  pr_type(t); printf("\n"));
                id = NULL;
            }
        }
        /* id is null here, if no tag is in use */

        /* Perform a structure definition. */
        if (t_type == LCURLY_TOK) {
            if (kind == CAST_TYPE) {
                fatal("{ inside cast");
            }

            /* Process the structure list. */
            TRACEP("pd_head", printf("structure list\n"));
            need(LCURLY_TOK);
            t -> t_list = pd_stmt(kind, TRUE, NULL);
            if (t -> t_list == NULL) {
                t_error("empty structure definition");
            }
            t -> t_tsize = pd_alloc(t -> t_list,
                    (kind == SELEMENT_TYPE)? 2 : 3);
            need(RCURLY_TOK);
            TRACEP("pd_head", printf("end structure list\n"));

            if (id != NULL && id -> st_type != t) {
                /* place the results of the definition */
                TRACEP("pd_head", printf("redefine tag\n"));
                if (id -> st_type -> t_list == NULL) {
                    id -> st_type -> t_list = t -> t_list;
                    id -> st_type -> t_tsize =
                                 t -> t_tsize;
                    t = id -> st_type;
                }
                else {
                    t_2error("redefinition of tag: ",symbol);
                }
            }
#if SC_STICKY == 0
            /*
                remove SC_MODS from the tag
                pd_post has not been called at this level at
                this time, so no recursion is required;
                it would be impossible anyhow
            */
            if (t -> t_mclass && id) {
                t1 = t;
                t = node_dupl(
                    (byte *) t, sizeof(struct type_node));
                t1 -> t_mclass &= ~SC_MODS;
            }
            TRACEP("pd_head", printf("detach tag from: ");
                                pr_type(t));
#endif
        }
        else {
            /* it's not a definition, so use what got looked
               up, if it was valid */
            if (id != NULL) {
                t -> t_list = id -> st_type -> t_list;
                t -> t_tsize = id -> st_type -> t_tsize;
#if SC_STICKY != 0
                t -> t_mclass |= id -> st_type -> t_mclass;
#endif
            }
        }
        /* attach tag name to structure node */
        t -> t_parent = id;
        break;

    case STAR_TOK:
    case LPAREN_TOK:
        /* Declarator may be imbedded. */
        break;

    case ID_TOK:
        /*
            Check to see whether ID is a typedef tag, or
            a variable or typedef identifier.

            Under error conditions we have some
            semantics-dependent syntax here. Maybe.

            We assume that if it's not typedef'd, then
            it's a function declarator.
        */
        id = ast_lookup(t_symbol);
        if (id != NULL && id -> st_sclass == TYPEDEF_CLASS) {
            if (t -> t_mclass & ARITH_MODS) {
                t_error("long, short, etc. do not apply to typedef tag");
                t -> t_mclass &= ~ARITH_MODS;
            }
            if (id -> st_type != NULL) {
                t = id -> st_type;
            }
            else {
                t_2error("pd_head: internal: typedef tag has NO TYPE: ", t_symbol);
            }
            get_token();
        }
        break;

    default:
        if (kind != CAST_TYPE) {
            t_error("variable declarator expected");
            TRACEP("pd_head", printf("token = %d\n", t_type));
        }
    }
    TRACEP("pd_head", printf("returns %p\n", t));
#ifdef DEBUG
    if (t == NULL) {
        fatal("pd_head: internal: returns NULL");
    }
#endif
    RETURN_PTR("pd_head", t);
}

/*
    Parse one declaration tail--that is, one collection of asterisks,
    parentheses, and brackets, possibly with an imbedded identifier.
    (This code handles casts, so the identifier is not always required.)
    Call t_error if an identifier that should be imbedded isn't,
    or in case of a duplicate, etc.

    Enter imbedded identifier into symbol table, and return the
    entry if an address for it is given.

    Parse grouping parentheses by recursive descent.

    Assumptions:
        The operator * is a prefix operator.
        The operators () and [] are postfix operators.
        The operator [25] is a case of [].
        The new-standard version of the arg list is not (yet) handled.

    kind:
        CAST_TYPE:    declaration is inside a cast.
        SELEMENT_TYPE:    declaration is inside a struct.
        UELEMENT_TYPE:    declaration is inside a union.

    headclass:
        EXTERN_CLASS:    etc.; includes classes denoted by
                keywords, and others

        Storage class to be attached to newly defined st_nodes.

    head_type:
        Whatever type the item is pointer-to, array-of, etc.;
        head_type is passed as NULL on descent!

    dsymbol:
        Address of a place to put a pointer to the symbol text,
        should one be found.  caller should set contents of that
        address to NULL, so as to be able to tell.
    regtype:
        Address of a place to put the register subtype at the
        time dsymbol is set, if dsymbol is set.

    return:
        Pointer to a type_node.

    fndef_ok:
        flag indicating that an identifier has been seen.
        Thus, function definition is possible.

    fnoverrun:
        Flag indicating that a '(' starting a function has been seen.
*/
static struct type_node *
pd_tail    (int kind, struct type_node * head_type,
        char ** dsymbol, int * regtype, int headclass)
{
    register struct type_node *t;

    TRACEPB("pd_tail", printf("(%d, %p, %p, %p, %d)\n",
        kind, head_type, dsymbol, regtype, headclass));

    if (dsymbol != NULL) {
        *dsymbol = NULL;
    }
    t = pd_t1(kind, head_type, dsymbol, regtype, headclass);
    if (t == NULL) {
        fatal("pd_tail: internal: returns NULL");
    }
    (void) pd_post(t);
    RETURN_PTR("pd_tail", t);
}

static struct type_node *
pd_t1(    int kind, struct type_node * head_type,
        char ** dsymbol, int * regtype, int headclass)
{
    register struct st_node *id;
    register struct node *p;
    int firstary;
    struct type_node root_node;
    struct type_node *star_node, *star_tail;
    register struct type_node *f_p, *t, *tail;

    bool fndef_ok, fnoverrun;

    TRACEPB("pd_t1", printf("(%d, %p, %p, %p, %d)\n",
        kind, head_type, dsymbol, regtype, headclass));

    TRACEP("pd_t1",
        printf("head_type %p; current t_type %d\n",
            head_type, t_type));

    /*
        NOTE:
        root_node is a vacuous item which is always
        on the modifying-declarator list, so that we need
        not replicate list-setup code all over the place
    */
    root_node.t_link = NULL;
    tail = &root_node;

    star_node = NULL;

    id = NULL;
    fnoverrun = 0;
    firstary = TRUE;

    /* Note again: ONE tail */

    /*
        First count up asterisks--pointer to.
        This is PRIOR TO encountering the identifier.
        Stars get prepended.
    */
    if (t_type == STAR_TOK) {
        /* first prepending */
        t = new_tnode();
        t -> t_typtok = POINTER_TYPE;
        t -> t_tsize = POINTER_SIZE;
        star_node = star_tail = t;

        for(get_token(); ; get_token()) {
            switch(t_type) {
            case STAR_TOK:
                /* subsequent prependings */
                t = new_tnode();
                t -> t_typtok = POINTER_TYPE;
                t -> t_tsize = POINTER_SIZE;
                t -> t_link = star_node;
                star_node = t;
                continue;
            case K_CONST:
                t -> t_mclass |= CONST_MOD;
                continue;
            case K_VOLATILE:
                t -> t_mclass |= VOLATILE_MOD;
                continue;
            }
            break;
        }
    }

    /* There can now be no more stars at this paren level. */

    /*
        Left parenthesis could be grouping parenthesis or it could
        be function-decl parenthesis.  Handle either case.

        If it is a function parenthesis, there can be no
        more left-parentheses for grouping, since the
        identifier or the missing identifier must be
        inside the innermost pair of grouping parentheses.

        Do the core, containing the (possibly implicit) identifier.
        A function () may be taken up as well.
    */
    if(t_type == LPAREN_TOK) {
        /*
            Since we have not seen an identifier yet, this branch
            can not lead to a function definition.
        */
        fndef_ok = FALSE;
        get_token();
        if (t_type == RPAREN_TOK) {
            /*
                Eventually, test for type declarator.
                We are in a cast for a function.
            */
            fnoverrun = TRUE;
        }
        else {
            /*
                The initial '(' was a grouping parenthesis.
                Parse the rest of the core recursively.
            */
            t = pd_t1(kind, NULL, dsymbol, regtype, headclass);
            if (t != NULL) {
                /* append core item */
                tail -> t_link = t;
                tail = t;

                /* reset tail */
                while (tail -> t_link) {
                    tail = tail -> t_link;
                }
            }
            need(RPAREN_TOK);
        }
    }
    else if (t_type == ID_TOK) {
        /*
            Now that we have seen an identifier, it is possible
            for a function definition to appear.
        */
        fndef_ok = TRUE;
        if (kind == CAST_TYPE) {
            t_warning("identifier within cast ignored");
        }
        else {
            if (dsymbol != NULL) {
                *dsymbol = str_salloc(t_symbol);
                *regtype = t_subtype;
                if (is_aregw(t_subtype)) {
                    t_2help(t_symbol, " has bizarre properties");
                }
            }
        }
        get_token();
    }
    else if (kind != CAST_TYPE &&
         head_type -> t_typtok != STRUCT_TYPE &&
         head_type -> t_typtok != UNION_TYPE) {
        fndef_ok = FALSE;
        t_error("missing object name in declaration");
    }

    /*
        GREAT DIVIDE.

        At this point, the core has been passed.
        We are ready to process function params or arrays.
        fnoverrun is a "virtual left paren" flag.
    */
    while (t_type == LPAREN_TOK || fnoverrun) {
        /*
            Append a function-returning node.
            With the new standard, these will have type lists,
            just like struct/union.
        */
        t = new_tnode();
        t -> t_typtok = FUNCTION_TYPE;
        t -> t_tsize = 0L;
        tail -> t_link = t;
        tail = t;    /* t is never null */

        /* Take up left paren if it hasn't already been gobbled. */
        if (!fnoverrun) {
            get_token();
        }
        fnoverrun = FALSE;

        /* Process an argument list if there is one. */
        if (t_type == ID_TOK && fndef_ok) {
            if (scope.s_scope != FILE_SCOPE && t_type == ID_TOK) {
                fatal("function definition in non-external context");
            }
            scope.s_scope = FNDEF_SCOPE;
            f_p = t;
            /*
                Do an old-style K&R type arg list.
                This is roughly an abbreviated pd_stmt.

                WARNING:
                This will have to change in the new standard.
            */
            for(;;) {
                if (id = rst_lookup(t_symbol)) {
                    t_2error("duplicate formal parameter: ",
                                 t_symbol);
                }
                else {
                    f_p -> t_list = new_tnode();
                    f_p = f_p -> t_list;
                    f_p -> t_typtok = DELEMENT_TYPE;
                    f_p -> t_link = new_tnode();
                    id = rst_enter(t_symbol,
                        f_p -> t_link, FORMAL_CLASS);
                    f_p -> t_parent = id;
                }

                get_token();
                if (t_type != COMMA_TOK) {
                    break;
                }
                get_token();
                if (t_type != ID_TOK) {
                    t_error("missing formal parameter");
                    break;
                }
            }
            scope.s_scope = FILE_SCOPE;
        }
        need(RPAREN_TOK);
        fndef_ok = FALSE;
    }
    /* at this point, we have processed leading *, the core, and
        any function-returning which are present at this level */

    while (t_type == LBRACK_TOK) {
        /* append array node */
        t = new_tnode();
        t -> t_typtok = ARRAY_TYPE;
        tail -> t_link = t;
        tail = t;

        /* eat the [ */
        get_token();
        TRACEP("pd_t1", printf("after [: t_type = %d\n",
                t_type));

        /* take the expression if there is one */
        switch(t_type) {
        case RCURLY_TOK:
        case LCURLY_TOK:
        case SEMICOLON_TOK:
        case EOF_TOK:
        case EOP_TOK:
            /* bad outcome */
            break;

        case RBRACK_TOK:
            if (firstary) {
                switch(headclass) {
                case FORMAL_CLASS:
                case FORMREG_CLASS:
                    /* formal array of indefinite dim */
                    t -> t_typtok = POINTER_TYPE;
                    t -> t_tsize = POINTER_SIZE;
                    break;

                case EXTERN_CLASS:
                    /* external array of indefinite dim */
                    break;
                default:
                    /* allow pointer to / function rtng
                       array of indefinite dimension */
                    if (tail == &root_node) {
                        t_error("missing array dimension");
                    }
                }
            }
            else {
                t_error("missing array dimension");
            }
            break;

        default:
            if (is_key(t_type)) {
                break;
            }
            if (kind == CAST_TYPE) {
                p = pe_expr1(TRUE);
            }
            else {
                /* WARNING: used to be expr(TRUE); */
                p = pe_expr();
            }
            if (!pe_number(p)) {
                t_error("array dimension must be a constant");
            }
            else {
                t_value = p -> n_const;

            }
            TRACEP("pd_t1", printf("dimension %ld\n",
                t_value));
            if (t_value >= 0) {
                t -> t_tdim = t_value;
            }
            else {
                t_error("negative array dimension");
            }
            break;

        }
        need(RBRACK_TOK);
        firstary = FALSE;
    }
    /* at this point, array dimensions at this level have been done */

    if (t_type == LPAREN_TOK) {
        t_error("unexpected (");
    }

    /* append stars, which may carry their consts and volatiles */
    if (star_node) {
        tail -> t_link = star_node;
        tail = star_tail;
    }

    /* append head_type node */
    tail -> t_link = head_type;

    /* drop root_node. */

    RETURN_PTR("pd_t1", (root_node.t_link));
}

/* ------------- INVISIBLE FUNCTIONS ------------ */


/*
    Go over the type (list of type_nodes) t1 and accomplish the following:
        assign array sizes
        complain about bad combinations, e.g. functions returning aggr.
        propagate const and volatile backwards across array-of
            and WARNING [forwards across structures]
    All of these involves interactions between two or more list elements,
    and the structure of this function reflects the fact that it does
    nothing if the list contains zero or one elements.

    CAUTION: it is assumed that t_mclass of non-int items only has
    SC_MODS raised.  If this becomes untrue, it will be necessary to
    do more masking.
*/
static int
pd_post(register struct type_node *t)
{
    register struct type_node *t1, *t2;

    TRACEPB("pd_post", printf("(%p)\n", t));

    if (t1 = t) {
        while (t2 = t1 -> t_link) {
            TRACEP("pd_post",
                printf("process %p: ", t1);
                pr_type(t1);
            );
            switch(t1 -> t_typtok) {
            case ARRAY_TYPE:
                if (t2 -> t_typtok == FUNCTION_TYPE) {
                    t_error("declared: array of functions");
                }
                else {
                    /* assign array size */
                    t1 -> t_tsize =
                        t1 -> t_tdim * t2 -> t_tsize;

                    /* NOTE: scmods might be mixed--
                       e.g. a volatile to propagate forward
                       and a const to propagate backward */

                    /* assign array scmods to element */
                    t2 -> t_mclass |= t1 -> t_mclass;

                    /* assign element scmods to array */
                    /* quasi SHORTCUT */
                    t1 -> t_mclass |= pd_post(t2);

                    /* avoid continuing on thru chain */

                    RETURN_INT("pd_post", t -> t_mclass & SC_MODS);
                }
                break;

            case FUNCTION_TYPE:
                switch(t2 -> t_typtok) {
                case STRUCT_TYPE:
                case UNION_TYPE:
                case ARRAY_TYPE:
                    if (t1 -> t_typtok == FUNCTION_TYPE) {
                        t_error("declared: function returning aggregate");
                    }
                    break;
                case FUNCTION_TYPE:
                    t_error("declared: function returning function");
                    break;
                }
            }
            t1 = t2;
        } /* end while */

        /* struct/union is terminal node, so check terminal */
        switch(t1 -> t_typtok) {
        case STRUCT_TYPE:
        case UNION_TYPE:
            TRACEP("pd_post", printf("structure: %p\n", t1));
            if (t1 -> t_mclass & SC_MODS) {
                /* go through each element node */
                t2 = t1; /* first t2 is the struct node;
                        then it is successive elt nodes */
                while (t2 -> t_list) {
                    /* replace the s/u element node */
#if SC_STICKY == 0
                    t2 -> t_list = node_dupl(
                        (byte *) t2 -> t_list,
                        sizeof(struct type_node));
#endif
                    t2 = t2 -> t_list; /* look at elt */

                    /* replace part of elt list */
                    t2 -> t_link = pd_p1(t2 -> t_link,
                             t1 -> t_mclass);
                }
            }
        }
        RETURN_INT("pd_post", (t -> t_mclass & SC_MODS));
    }
    else {
        RETURN_INT("pd_post", 0);
    }
}

/*
    This is the substructure version of pd_post

    It doesn't bother with checks, since they are done already;
    its only job is to propagate SC_MODS in the forward direction
    from a struct/union, and it only traverses to the extent
    necessary to do this.  This also prevents
    struct tag {
        struct tag *p;
    }
    from looping forever.
*/
static struct type_node *
pd_p1(register struct type_node *t, register int mods)
{
    register struct type_node *t1, *t2, *t3;

    /* t is the attachment point */

    TRACEPB("pd_p1", printf("(%p, %d)\n", t, mods));

    if (t == NULL) {
        RETURN_PTR("pd_p1", t);
    }
    t1 = t;

    /* go through the list linkwise (only) */
#if SC_STICKY == 0
    /* new attachment point */
    t = t1 = node_dupl( (byte *) t1, sizeof(struct type_node));
#endif
    t1 -> t_mclass |= mods;

    while ((t2 = t1 -> t_link) && t1 -> t_typtok == ARRAY_TYPE) {
        /* assign scmods to array element */
#if SC_STICKY == 0
        t2 = t1 -> t_link = node_dupl( (byte *) t2,
                        sizeof(struct type_node));
#endif
        t2 -> t_mclass |= t1 -> t_mclass;
        t1 = t2;
    } /* end while */

    switch(t1 -> t_typtok) {
    case STRUCT_TYPE:
    case UNION_TYPE:
        TRACEP("pd_p1", printf("structure: %p\n", t1));
        /* propagate const through element list */
        t2 = t1;
        while (t2 -> t_list) {
            /* replace the s/u element node */
#if SC_STICKY == 0
            t2 -> t_list = (void *)
                node_dupl( (byte *) t2 -> t_list,
                       sizeof(struct type_node));
#endif
            t2 = t2 -> t_list;    /* now look at the node */

            /* replace what is linked to the s/u element node */
            t2 -> t_link = pd_p1(t2 -> t_link,
                             t1 -> t_mclass);
        }
    }
    RETURN_PTR("pd_p1", t);
}


/*
    Enter a symbol that has been fished out of a pd_tail onto
    some symbol table.  Context information is used to determine
    whether duplicate entries are OK, and so on.

    A symbol table entry, guaranteed non-NULL, is returned.
    In FNDEF_SCOPE only, it may be that id -> st_type differs
    from type, and should replace type; the caller must deal with this.

    For FNDEF_SCOPE, the type_nodes are made in global memory.  The
    st_nodes and symbols are made in local memory.
*/
static struct st_node *
pd_var(int sclass, struct type_node *type, char * symbol)
{
    register struct st_node *id, *id1;
    register struct type_node *t;
    register int ttok;

    TRACEPB("pd_var", printf("(%d, %p, %s)\n", sclass, type, symbol));

    TRACEP("pd_var",
        pr_type(type);
        printf("class: ");
        pr_sclass(sclass);
        printf("\n");
    );

#ifdef DEBUG
    if (type == NULL) {
        fatal("pd_var: internal: no type");
    }
#endif /* DEBUG */

    ttok = type -> t_typtok;
    if (ttok == FUNCTION_TYPE) {
        if (sclass == STATICG_CLASS) {
            sclass = SCODE_CLASS;
        }
        else {
            sclass = CODE_CLASS;
        }
        TRACEP("pd_var", printf("classify as code\n"));
    }
    else {
        if (ttok == VOID_TYPE) {
            t_2error(symbol, " declared void");
        }
        else if (is_element(ttok)) {
            sclass = SUE_CLASS;
            TRACEP("pd_var", printf("classify as element\n"));
        }
    }

    /*
        WARNING: undefined structure can't be checked until decls are
           all done.
    */

    /* Look it up and enter it but in the current scope only. */
    id = rst_lookup(symbol);
    if (id == NULL) {
        /*
            id is not a duplicate symbol; set it up
        */
        id = rst_enter(symbol, type, sclass);
        id -> st_misc |= EXPLICIT_SYM;
        if (scope.s_scope == FNDEF_SCOPE) {
            t_2error("not in formal list: ", symbol);
        }

        /* Fix id's alias if it is a static declarator */
        /* NOTE: functions declared static are already CODE_CLASS */
        if (sclass == STATICL_CLASS) {
            id -> st_alias = str_salloc(pd_name());
        }
    }
    else if (scope.s_scope == FNDEF_SCOPE) {
        /*
            Formal scope duplicate messages.
            Formal scope reentry.
        */
        if (id -> st_misc & EXPLICIT_SYM) {
            t_2error("duplicate type specification of formal: "
                                , symbol);
        }
        else {
            TRACEP("pd_var",
                   printf("reenter formal %p\n", type));
            if (type != NULL) {
                switch(ttok) {
                case FUNCTION_TYPE:
                    t_2error("formal declared a function: "
                                , symbol);
                    break;

                case UNION_TYPE:
                case ARRAY_TYPE:
                case STRUCT_TYPE:
                    t_2error("formal declared an aggregate: "
                                , symbol);
                    break;
                }
            }
            /* Update the type inside the actual node. */
            pd_tcopy(type, id -> st_type);
            id -> st_sclass = sclass;
            id -> st_misc |= EXPLICIT_SYM;
        }
    }
    else {
        /*
            Non-formal scope duplicate messages
        */
        switch(ttok) {
        case SELEMENT_TYPE:
        case UELEMENT_TYPE:
            if (!pd_teq(type, id -> st_type))
                switch(id -> st_type -> t_typtok) {
            case SELEMENT_TYPE:
            case UELEMENT_TYPE:
              if (type -> t_tdim !=
                    id -> st_type -> t_tdim) {
                  t_2error("element offset conflict: ",
                            symbol);
              }
              else {
                t_2error("element type conflict: ",
                            symbol);
              }
              break;
            default:
              t_2error("not an element: ", symbol);
            }
            break;

        case FUNCTION_TYPE:
            if (!pd_teq(type, id -> st_type)) {
                t_2error("redeclaration of function: ",
                            symbol);
            }
            break;

        default:
            t_2error("duplicate symbol: ", symbol);
        }
    }
    RETURN_PTR("pd_var", id);
} /* end pd_var */

/*
    Return a unique symbolic name for a (static) variable.
*/
static char *
pd_name(void)
{
    static char buf[LONG_DIGITS+5];
    static unsigned long ssn = 1;

    TICK("pd_name");

    buf[0] = 'V';
    conul2sc(ssn, buf+1, 2);

    TRACEP("pd_name", printf("%d  %s\n", str_len(buf), buf));
    ssn++;
    return &buf[0];
}

/*
    Parse initializers, and attach the initializer block(s) to
    the symbol id

    Initializer blocks come in several functions.  The enumeration
    ..._DEC in enum.h lists these.  Type zero is the array list, which
    contains n slots each of which holds a pointer and a numerical
    constant.  It may in the end be preferable to instead make each
    slot a polymorphic longword with its own type.  The pointer form
    will point to a loc_node that can hold a constant and a label, in
    order to accomodate initializers of the (label + offset) variety.
    According to K&R, that is the most complex form possible.  Some
    users of realtime rom-based systems might not mind being able to
    pass through any parse tree that the assembler can handle, in which
    case the pointer might point to a general parse node instead of just
    a loc_node.

    The IBSSZB type is used for filler blocks in incomplete
    initializations.  It is essentially meant to finesse the situation
    where a user declares  int x[100000] = 0;  and avoid attempting
    to produce in the compiler an array of 100000 double-longword
    structures!  To keep things regular, this block is used for all
    fillers.

    The ISTRA type is for string arrays, in the sense of an array of
    char declared as a string.  It is used for declarations like
    char a[6] = "hello";  and for implicit declarations in code.

    String pointer arrays declared as arrays of strings are "under
    development."  Implicit string declarations in code, i.e. char *p;
    p = "hello"; create internal labels for the strings.  These labels
    get entered into the symbol table, so that the loc_node can point
    back to a symbol in the customary fashion.  (Entry into the table is
    primarily the most expedient way to get the symbol node created; the
    symbols are not looked up in the table.)  The declaration
    char *a[] = {"first", "second", "third};
    is a little different again, in that it sets up THREE objects; namely,
    the internal label, the string itself, and the pointer variable.  Each
    string declarator sets up two physical objects in storage, rather than
    the usual one.
*/
static void
pd_iniz(struct st_node *id)
{
    TICK("pd_iniz");
    if (t_type == LCURLY_TOK) {
        get_token();
        id -> st_iniz = pd_par(id -> st_type, 1L);
        (void) needend(RCURLY_TOK);
    }
    else {
        id -> st_iniz = pd_par(id -> st_type, 1L);
    }
    /* supplementary error message */
    switch(t_type) {
    default:
        t_2error("declarator or semicolon expected at: ",
        ps_tok(t_type));
    case ID_TOK:
    case SEMICOLON_TOK:
    case STAR_TOK:
    case COMMA_TOK:
    case LPAREN_TOK:
        ;
    }
}

/*
    In effect we enter here from pd_iniz() with the outer braces
    stripped.
*/
static struct iblock *
pd_par(register struct type_node *t, unsigned long size)
{
    register unsigned int j;
    register unsigned long i, c;
    register struct iblock *p, *q, *s;
    struct iblock base;
    struct st_node *id;
    int minus;

    TRACEPB("pd_par",
        printf("(%p, %lu)\n", t, size);
        pr_type(t));

#ifdef DEBUG
    if (t == NULL) {
        t_error("internal: pd_par: no type");
        RETURN_PTR("pd_par", NULL);
    }
#endif

    p = NULL;

    switch (t -> t_typtok) {
    case INT_TYPE:
    case POINTER_TYPE:
        /* get a decl block, which holds up to IDATA_SIZE long entries */
        p = q = new_iblock((size)? size : (unsigned long) IDATA_SIZE);

        q -> isize = (byte) t -> t_tsize;
        c = q -> idim;

        for (j = 0, i = 0; size == 0 || i < size; i++) {

            /* WARNING: must call pe_expr() if operators are found */
            /* probably should use character lookahead and call
                pe_expr if next is not ,;{} */

            if (minus = (t_type == MINUS_TOK)) {
                get_token();
            }

            /* this is forced to be an "if" statement since it
                needs in one case to break out of the "for" loop */
            if (t_type == INT_TOK || t_type == LONG_TOK ||
                            t_type == STRING_TOK) {
                if (j >= IDATA_SIZE) {
                    /* append another block */
                    /* request remaining size */
                    q -> ilink = new_iblock(
                      (size)? size - i: (unsigned long) IDATA_SIZE);
                    q = q -> ilink;
                    q -> isize = (byte) t -> t_tsize;
                    /* tot up actual initializers covered */
                    c += q -> idim;
                    j = 0;
                }
                if (t_type != STRING_TOK) {
                    if (minus) {
                        t_value = -t_value;
                    }
                    if (pe_oversize(t -> t_mclass, t_value) >= 2) {
                        t_error("oversized initializer");
                    }
                    q -> idata[j++] . icn = t_value;
                }
                else {
                    s = new_iblock(2L);
                    s -> itype = ISTRS_DEC;
                    s -> isize = 1;
                    s -> idata[0] . ipt =
                        (void *) str_lalloc(t_symbol);
                    s -> idim = (unsigned long)
                        str_val(s -> idata[0] . ipt);
                    s -> idata[1] . ipt =
                        (void *)str_lalloc(str_name());
                    q -> idata[j++] . ipt = (char *) s;
                    if (t -> t_tsize != 4) {
        t_error("string pointer truncated");
        TRACEP("pd_par", printf("t -> t_tsize = %ld\n", t -> t_tsize));
                    }
                }
                get_token();
            }
            /* temporary code to handle address-of */
            else if (t_type == AND_TOK) {
                get_token();
                if (j >= IDATA_SIZE) {
                    /* append another block */
                    /* request remaining size */
                    q -> ilink = new_iblock(
                      (size)? size - i: (unsigned long) IDATA_SIZE);
                    q = q -> ilink;
                    q -> isize = (byte) t -> t_tsize;
                    /* tot up actual initializers covered */
                    c += q -> idim;
                    j = 0;
                }
                if (t_type == ID_TOK) {
                    if (id = ast_lookup(t_symbol)) {
                        s = new_iblock(1L);
                        s -> itype = ITAG_DEC;
                        s -> idata[0].ipt =
                              id -> st_alias;
                        q -> idata[j++] . ipt =
                            (char *) s;
                    }
                    else {
                        t_2error("undefined symbol: ",
                                    t_symbol);
                        j++;
                    }
                    get_token();
                }
                else {
                        t_2error("cannot handle declaration syntax at: ",
                        ps_tok(t_type));
                }
            }
            else {
                break;
            }

            if (t_type == COMMA_TOK) {
                get_token();
            }
            else {
                break;
            }
        }
        /* append a bsszb block to fill out size */
        if (size) {
            if (size > c) {
                q -> ilink = new_iblock(0L);
                q = q -> ilink;
                q -> idim = (size - c) * t -> t_tsize;
                q -> itype = IBSSZB_DEC;
            }
        }
        else {
            q -> idim = (unsigned long)j;
        }

        TRACEP("pd_par",
            q = p;
            while(q) {
                pr_iblock(q);
                q = q -> ilink;
            }
        );
        break;

    case ARRAY_TYPE:
        q = &base;
        base . ilink = NULL;

        /* get chain of blocks */
        TRACEP("pd_par", array: pr_type(t -> t_link));
        if (t_type == STRING_TOK &&
            t -> t_link -> t_typtok == INT_TYPE &&
                t -> t_link -> t_tsize == 1) {
            /* generate special string block */
            p = new_iblock(1L);
            p -> itype = ISTRA_DEC;
            p -> isize = 1;
            p -> idata[0] . ipt = (void *) str_lalloc(t_symbol);
            i = (unsigned long) str_val(p->idata[0].ipt);
            if (t -> t_tdim && i > t -> t_tdim) {
                i = t -> t_tdim;
                ((char *) p -> idata [0] . ipt) [i] = 0;
                t_warning("string initializer truncated");
            }
            p -> idim = i;
            TRACEP("pd_par", pr_iblock(p));
            if (i < t -> t_tdim) {
                q = new_iblock(0L);
                p -> ilink = q;
                q -> itype = IBSSZB_DEC;
                q -> idim = t -> t_tdim - i;
                TRACEP("pd_par", pr_iblock(q));
            }
            get_token();
        }
        else if (t_type == LCURLY_TOK) {
            /* get a braced set of initializers */
            if (t -> t_tdim == 0) {
                t_error("missing dimension, initialized array");
            }
            for (i = 0; i < t -> t_tdim; ) {
                TRACEP("pd_par", printf("array: i = %lu\n", i));
                get_token();
                q -> ilink = pd_par(t -> t_link, 1L);
                i++;

                /* seek to end of chain */
                while (q -> ilink) {
                    q = q -> ilink;
                }

                /* eat a right brace */
                if (!needend(RCURLY_TOK)) {
                    break;
                }
                /* and a comma */
                if (t_type != COMMA_TOK) {
                    break;
                }
                get_token();
                if (t_type != LCURLY_TOK) {
                    break;
                }
            }
            /* append a bsszb block to fill out size */
            if (i < t -> t_tdim) {
                q -> ilink = new_iblock(0L);
                q -> ilink -> itype = IBSSZB_DEC;
                q = q -> ilink;
                q -> idim = (t -> t_tdim - i) *
                            t -> t_link -> t_tsize;
                TRACEP("pd_par", pr_iblock(q));
            }
            /* t is no good here */
            p = base.ilink;
        }
        else {
            /* get an open list of initializers */
            if (t -> t_tdim == 0) switch (t -> t_link -> t_typtok){
            case INT_TYPE:
            case POINTER_TYPE:
                break;
            default:
                t_error("missing dimension, initialized array");
            }
            TRACEP("pd_par", printf("open list\n"));
            p = pd_par(t -> t_link, size * t -> t_tdim);
        }
        break;

    case STRUCT_TYPE:
        /* do this the simplest way */
        q = &base;
        base . ilink = NULL;
        while (t = t -> t_list) {
            switch(t -> t_link -> t_typtok) {
            case STRUCT_TYPE:
            case ARRAY_TYPE:
                if (t_type == LCURLY_TOK) {
                    get_token();
                    q -> ilink = pd_par(t -> t_link, 1L);
                    q = q -> ilink;
                    (void) needend(RCURLY_TOK);
                    break;
                }
                /* FALLTHROUGH */
            default:
                q -> ilink = pd_par(t -> t_link, 1L);
                q = q -> ilink;
            }
        }
        p = base.ilink;
        break;

    case FUNCTION_TYPE:
        t_error("cannot initialize a function");
        break;

    default:
        t_error("cannot initialize object of this type");
        TRACEP("pd_par", pr_type(t); printf("\n"));
    }
    /* CAUTION: size and t are no good here */
    RETURN_PTR("pd_par", p);
}